home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / diskutil / multicop.lzh / MULTICOP.FOR next >
Text File  |  1993-09-23  |  30KB  |  973 lines
  1. C       MULTICOP.FOR
  2. C               MULTICOP
  3. C               ESKIP
  4. C               FMTCOP
  5. C               ERROR
  6. C               SETSTA
  7. C               FEXIT
  8. C               AESSET
  9. C               DOFORM
  10. C----------------------------------------------------------------------
  11. C                                  MULTICOP
  12. C----------------------------------------------------------------------
  13. C
  14. C       Program to fast format and copy to disks
  15. C
  16. C       Read returns:
  17. C       A       Initial entry
  18. C       B       Abort read
  19. C       C       Read error
  20. C       D       Return form write form: write done
  21. C       E       Exit from write form
  22. C       F       End of HELP/ABORT
  23. C       G       Boot block error
  24. C       H       SPT/NTRACK error
  25. C
  26. C----------------------------------------------------------------------
  27. C
  28.         PROGRAM MULTICOP
  29.         INCLUDE 'MULTICOP.INC'
  30.         INCLUDE 'MULTICOP.JNC'
  31.            
  32. C   Local
  33.  
  34.         INTEGER*1 BNSTR(12),PKR1
  35.         INTEGER*2 LINE(0:3),DL(0:7),PKR2(2)
  36.         INTEGER*4 form_do,form_alert,objc_state
  37.         INTEGER*4 I,J,K,K1,K2,XX,XXX,RES,RDRV,WDRV,NDRV,HANDLE
  38.         INTEGER*4 EVENT,evnt_multi,objc_find,PMX,PMY,PMB,PKS,PKR,PBR
  39.         INTEGER*4 IADSEC,NTRACK,ITRACK,IH,IS,IM,IDN,NN
  40.         INTEGER*4 PX,PY,CXA(0:1),CYA(0:1)
  41.         INTEGER*4 STATE(0:1)
  42.         CHARACTER NAME*8,NSTR*12,ZERO*1
  43.         CHARACTER*7 DISK(0:1)
  44.         EQUIVALENCE (BNSTR,NSTR),(PKR2,PKR),(PKR2(2),PKR1)
  45.  
  46. C   Form parameters
  47.  
  48.         INTEGER*4 OBJADD(0:NF),FX(0:NF),FY(0:NF),FW(0:NF),FH(0:NF)
  49.         COMMON /FRM/OBJADD,FX,FY,FW,FH
  50.         
  51.         INTEGER*4 CADD,FADD,CX,CY,CW,CH,X,Y,W,H
  52.         INTEGER*4 IBUT,HBUT
  53.         EQUIVALENCE (CADD,OBJADD(0)),(FADD,OBJADD(1))
  54.         EQUIVALENCE (CX,FX(0)),(X,FX(1))
  55.         EQUIVALENCE (CY,FY(0)),(Y,FY(1))
  56.         EQUIVALENCE (CW,FW(0)),(W,FW(1))
  57.         EQUIVALENCE (CH,FH(0)),(H,FH(1))
  58.         
  59.         INTEGER*1 SECTOR0(512,20,85),BUF(10000),BTBK(512)
  60.         INTEGER*1 SECTOR1(512,20,85)
  61.         INTEGER*4 SPT,SPD,NSIDES
  62.         INTEGER*4 WW,D1,D2,D3,D4,D5,D6,D7,D8,D9,D10,D11
  63.         INTEGER*4 CDA1,CDA2,CDA3,CDA4,CDA5,CDA6,CDA7
  64.         INTEGER*4 CDA8,CDA9,CDA10,CDA11
  65.         INTEGER*4 CDB1,CDB2,CDB3,CDB4,CDB5,CDB6,CDB7
  66.         INTEGER*4 CDB8,CDB9,CDB10,CDB11
  67.         EQUIVALENCE (SECTOR0,BTBK)
  68.         LOGICAL*4 RANNUM
  69.         
  70.         DATA NAME/'MULTICOP'/
  71.         DATA DISK/'Disk A ','Disk B '/
  72.  
  73.         ZERO=CHAR(0)
  74.         DISK(0)(7:7)=ZERO
  75.         DISK(1)(7:7)=ZERO
  76.                   
  77. C-------------------------------------------------------------MULTICOP
  78.  
  79. C   Formats
  80.  
  81. 1       FORMAT(I1)
  82. 2       FORMAT(I2)
  83. 4       FORMAT(I4)
  84. 10      FORMAT(I10)
  85.  
  86. C   Initialise AES
  87.  
  88.         CALL AESSET(HANDLE,NAME,-1,RES,OBJADD,FX,FY,FW,FH)
  89.         CALL graf_mouse(0,0)
  90.         CALL graf_mouse(256,0)                  !hide mouse
  91.         CALL objc_offset(FADD,READBAR,PX,PY)
  92.         CALL objc_offset(CADD,BARA,CXA(0),CYA(0))                
  93.         CALL objc_offset(CADD,BARB,CXA(1),CYA(1))
  94.  
  95. C   Initialise states
  96.  
  97.         CALL objc_read(FADD,READBAR,D1,D2,D3,D4,D5,D6,D7,
  98.      1                              D8,D9,D10,D11)
  99.         CALL objc_read(CADD,BARA,CDA1,CDA2,CDA3,CDA4,CDA5,CDA6,CDA7,
  100.      1                           CDA8,CDA9,CDA10,CDA11)
  101.         CALL objc_read(CADD,BARB,CDB1,CDB2,CDB3,CDB4,CDB5,CDB6,CDB7,
  102.      1                           CDB8,CDB9,CDB10,CDB11)
  103.      
  104. C   Start with mouse showing
  105.  
  106.         CALL graf_mouse(257,0)
  107.  
  108. C-------------------------------------------------------------------
  109. C                              Set up read form
  110.  
  111. C   Define read form;  hide mouse
  112.  
  113. 2000    CALL form_dial(0,0,0,0,0,X,Y,W,H)       !open dialog box
  114.  
  115. C   Hide mouse & clear read statistics and read button
  116.  
  117.         CALL ESKIP(0,1,*2100)               !Type A return
  118.  
  119. C   Draw read form
  120.  
  121. 2100    CALL objc_draw(FADD,0,32767,X,Y,W,H)
  122.         
  123. C--------------------------------------------------------------------
  124. C                       Process read form
  125.  
  126. 1000    CALL graf_mouse(257,0)
  127.         IBUT=form_do(FADD,0)
  128.         CALL graf_mouse(256,0)
  129.         IF (IBUT.NE.READIT)
  130.      1    CALL objc_change(FADD,IBUT,0,X,Y,W,H,0,.TRUE.)
  131.             
  132. C   Analyse exits
  133. C   Abort
  134.  
  135.         IF (IBUT.EQ.EXITR) THEN
  136.           CALL FEXIT(HANDLE,X,Y,W,H)
  137.  
  138. C   Give help
  139.  
  140.         ELSE IF (IBUT.EQ.HELP) THEN
  141.           CALL form_dial(3,0,0,0,0,X,Y,W,H)       !close box
  142.           CALL DOFORM(2,HBUT,0)
  143.           IF (HBUT.EQ.MORE) CALL DOFORM(3,HBUT,0)
  144.           CALL form_dial(0,0,0,0,0,X,Y,W,H)
  145.           CALL objc_draw(FADD,0,32767,X,Y,W,H)
  146.           GOTO 1000                               !Type F return
  147.  
  148. C   Abort
  149.  
  150.         ELSE IF (IBUT.EQ.ABORTR) THEN
  151.           GOTO 1000                               !rType F return
  152.           
  153. C   Read the disk
  154.         
  155.         ELSE
  156.   
  157.       
  158. C   Get the disk
  159.  
  160.           RDRV=objc_state(FADD,DISKB)
  161.  
  162. C   Read the disk number flag
  163.  
  164.           RANNUM=(objc_state(FADD,YESDN).GT.0)
  165.           
  166. C   Read boot block of master disk
  167.  
  168.           CALL FLOPRD(K,BTBK,RDRV,1,0,0,1)
  169.           IF (K.NE.0) THEN
  170.             I=form_alert(1,'[3][Error in boot block][Abort]')
  171.             CALL objc_change(FADD,IBUT,0,X,Y,W,H,0,.TRUE.)
  172.             GOTO 1000                           !Type G return
  173.           END IF
  174.           
  175.           IADSEC=IADDR(SECTOR0)
  176.  
  177. C   Get Sectors/track: SPT
  178.          
  179.           K1=(IPEEK1(IADSEC+25).AND.255)
  180.           CALL ISHFT(K1,K1,8)
  181.           K2=(IPEEK1(IADSEC+24).AND.255)
  182.           SPT=(K1.OR.K2)
  183.  
  184. C   Get sectors/disk: SPD
  185.  
  186.           K1=(IPEEK1(IADSEC+20).AND.255)
  187.           CALL ISHFT(K1,K1,8)
  188.           K2=(IPEEK1(IADSEC+19).AND.255)
  189.           SPD=(K1.OR.K2)
  190.  
  191. C   Get number of sides: NSIDES
  192.  
  193.           K1=(IPEEK1(IADSEC+27).AND.255)
  194.           CALL ISHFT(K1,K1,8)
  195.           K2=(IPEEK1(IADSEC+26).AND.255)
  196.           NSIDES=(K1.OR.K2)
  197.  
  198. C   Get disk number
  199.  
  200.           I=BTBK(9).AND.255
  201.           J=BTBK(10).AND.255
  202.           K=BTBK(11).AND.255
  203.           IDN=K+256*(J+256*I)
  204.  
  205. C   Get number of tracks: NTRACK
  206.  
  207.           NTRACK=SPD/(SPT*NSIDES)
  208.  
  209. C   Display some statistics
  210. C   First drive name
  211.  
  212.           CALL objc_newtext(FADD,SOURCE,DISK(RDRV))
  213.           CALL objc_draw(FADD,SOURCE,0,X,Y,W,H)
  214.           
  215. C   Sectors/track
  216.  
  217.           WRITE(NSTR(1:2),2) SPT
  218.           BNSTR(3)=0
  219.           CALL objc_newtext(FADD,SPTT,NSTR)
  220.           CALL objc_draw(FADD,SPTT,32767,X,Y,W,H)
  221.  
  222. C   Sectors/disk
  223.  
  224.           WRITE(NSTR(1:4),4) SPD
  225.           BNSTR(5)=0
  226.           CALL objc_newtext(FADD,SPDT,NSTR)
  227.           CALL objc_draw(FADD,SPDT,0,X,Y,W,H)
  228.  
  229. C   Sides/disk
  230.           
  231.           WRITE(NSTR(1:1),1) NSIDES
  232.           BNSTR(2)=0
  233.           CALL objc_newtext(FADD,SIPDT,NSTR)
  234.           CALL objc_draw(FADD,SIPDT,0,X,Y,W,H)
  235.  
  236. C   Tracks/side
  237.  
  238.           WRITE(NSTR(1:2),2) NTRACK
  239.           BNSTR(3)=0
  240.           CALL objc_newtext(FADD,TDDT,NSTR)
  241.           CALL objc_draw(FADD,TDDT,0,X,Y,W,H)
  242.  
  243. C   Test SPT and NTRACK
  244.  
  245.           IF (SPT.GT.11.OR.NTRACK.GT.85) THEN
  246.             IF (SPT.GT.11)
  247.      1        I=form_alert(1,'[3][Too many sectors/track][Abort]')
  248.             IF (NTRACK.GT.85)
  249.      1        I=form_alert(1,'[3][Too many tracks][Abort]')
  250.             CALL ESKIP(1,0,*1000)            !Type H return
  251.           END IF  
  252.  
  253. C   Disk #
  254.  
  255.           WRITE(NSTR(1:10),10) IDN
  256.           BNSTR(11)=0
  257.           CALL objc_newtext(FADD,DISKN,NSTR)
  258.           CALL objc_draw(FADD,DISKN,0,X,Y,W,H)
  259.           
  260.           IF (RANNUM) THEN
  261.             CALL TIME(IH,IM,IS,IH)
  262.             XX=RANDOM(IM*60+IS)
  263.           END IF
  264.  
  265. C   Set up progress bar X coordinate and box size
  266.  
  267.           WW=2*NTRACK+1
  268.           IF (WW.NE.D10) THEN
  269.             CALL objc_write(FADD,READBAR,D1,D2,D3,D4,D5,D6,D7,
  270.      1                                   D8,D9,WW-2,D11)
  271.             CALL objc_draw(FADD,READBAR,0,X,Y,W,H)          
  272.             CALL objc_write(CADD,BARA,CDA1,CDA2,CDA3,CDA4,CDA5,CDA6,
  273.      1                      CDA7,CDA8,CDA9,WW,CDA11)
  274.             CALL objc_write(CADD,BARB,CDB1,CDB2,CDB3,CDB4,CDB5,CDB6,
  275.      1